knitr::opts_chunk$set(echo = TRUE, fig.width=8, fig.height=4)
knitr::opts_knit$set(root.dir = "C:/Users/Peter/Documents/GU/data/som/")
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(rio)
library(ggplot2)
library(RColorBrewer)
library(tidyverse)
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Conflicts with tidy packages ----------------------------------------------
## filter(): dplyr, stats
## lag(): dplyr, stats
theme_set(theme_minimal())
# Läs in Super-SOM.
if(file.exists("supersom.RData"))
{
print("Load RData")
load("supersom.rdata")
} else {
print("Import")
system.time(supersom <- import("supersom/SND0905_SuperRSOM_v5.sav"))
print("Saving RData")
save.image(file="supersom.rdata")
}
## [1] "Load RData"
# Recode rank variable into binary categorical factor.
dummy <- function(x, one=c(1, 2, 3, 4), zero=c(6, 7), labels=c("5 days/week or more", "More seldom"))
{
newx <- NA
newx[x %in% one] <- 1
newx[x %in% zero] <- 0
newx <- factor(newx, levels=c(1, 0), labels=labels)
return(newx)
}
# Recode rank variable into trichotomous categorical factor.
trichotomy <- function(x, two, one, zero, labels=c("Daily", "Weekly", "Never/seldom"))
{
newx <- NA
newx[x %in% two] <- 2
newx[x %in% one] <- 1
newx[x %in% zero] <- 0
newx <- factor(newx, levels=c(2, 1, 0), labels=labels)
return(newx)
}
In general:
# Demography.
supersom$ideology <- supersom$ba10 # Self-reported political left/right placement 1-5.
supersom$ideology[supersom$ideology >= 98] <- NA
supersom$polinterest <- supersom$ca10 %>% recode("1"="4", "2"="3", "3"="2", "4"="1") %>% as.numeric()
supersom$polinterest <- factor(supersom$polinterest, levels=c(1, 2, 3, 4), labels=c("No political interest", "Low", "Medium", "High political interest"))
supersom$polinterest.num <- as.numeric(supersom$polinterest) # Numeric 1-4 political interest.
# Public service.
supersom$svt1 <- supersom$jd20a # SVT1
supersom$svt2 <- supersom$jd20b # SVT2 (1992-2014)
supersom$svt1svt2 <- supersom$jd20c # SVT1/SVT2 (2006-2013)
supersom$rapport <- supersom$jh10d # SVT1 Rapport
supersom$aktuellt <- supersom$jh10c # SVT2 Aktuellt
supersom$aktuelltrapport <- supersom$jh10e # Aktuellt/Rapport
supersom$ekot <- supersom$jh10b # SR Ekot
# Trust SVT.
supersom$trust.svt <- supersom$ka502a %>% recode("1"="3", "2"="3", "3"="2", "4"="1", "5"="1")
## Warning: Unreplaced values treated as NA as .x is not compatible. Please
## specify replacements exhaustively or supply .default
supersom$trust.svt <- factor(supersom$trust.svt, levels=c(3, 2, 1), labels=c("High trust", "Neither low nor high", "Low trust"))
supersom$trust.sr <- supersom$ka502e %>% recode("1"="3", "2"="3", "3"="2", "4"="1", "5"="1")
## Warning: Unreplaced values treated as NA as .x is not compatible. Please
## specify replacements exhaustively or supply .default
supersom$trust.sr <- factor(supersom$trust.sr, levels=c(3, 2, 1), labels=c("High trust", "Neither low nor high", "Low trust"))
# Internet, social networking sites.
supersom$internet <- supersom$jb19 # Internet use last 12 months (1995-)
supersom$internetnews <- supersom$jb110c # Internet news use (2005-)
supersom$sns <- supersom$jb110p # Social media use, e.g. Facebook, Twitter (2009-)
# Recode into binary.
supersom$svt1.dich <- dummy(supersom$svt1, one=c(2, 3), zero=c(4, 5, 6, 7))
supersom$svt2.dich <- dummy(supersom$svt2, one=c(2, 3), zero=c(4, 5, 6, 7))
supersom$rapport.dich <- dummy(supersom$rapport, one=c(1, 2), zero=c(3, 4, 5, 6))
supersom$aktuellt.dich <- dummy(supersom$aktuellt, one=c(1, 2), zero=c(3, 4, 5, 6))
supersom$ekot.dich <- dummy(supersom$ekot, one=c(1, 2), zero=c(3, 4, 5, 6))
supersom$sns.dich <- dummy(supersom$sns, one=c(7, 6), zero=c(5, 4, 3, 2, 1))
supersom$internet.dich <- dummy(supersom$internet, one=c(5), zero=c(4,3,2,1), labels=c("Use internet daily", "Use internet more seldom"))
supersom$internetnews.dich <- dummy(supersom$internetnews, one=c(7,6), zero=c(5,4,3,2,1))
# Recode into trichotomoy
supersom$svt1.tri <- trichotomy(supersom$svt1, two=c(2), one=c(3, 4, 5), zero=c(6, 7))
supersom$svt2.tri <- trichotomy(supersom$svt2, two=c(2), one=c(3, 4, 5), zero=c(6, 7))
supersom$rapport.tri <- trichotomy(supersom$rapport, two=c(1), one=c(2, 3, 4), zero=c(5, 6))
supersom$aktuellt.tri <- trichotomy(supersom$aktuellt, two=c(1), one=c(2, 3, 4), zero=c(5, 6))
supersom$ekot.tri <- trichotomy(supersom$ekot, two=c(1), one=c(2, 3, 4), zero=c(5, 6))
supersom$sns.tri <- trichotomy(supersom$sns, two=c(7), one=c(6, 5), zero=c(4, 3, 2, 1))
# Issue positions.
supersom$marry <- dummy(supersom$fc10e, one=c(1, 2, 3), zero=c(4), labels=c("Agree", "Disagree")) # "I would not like immigrant marriying family member."
# Combine Aktuellt/Rapport into single variable.
supersom$aktuelltrapport.dich[supersom$year %in% c(1984:2004)] <- ifelse(supersom$aktuellt[supersom$year %in% c(1984:2004)] <= 5 | supersom$rapport[supersom$year %in% c(1984:2004)] <= 5, 1, 0)
supersom$aktuelltrapport.dich[supersom$year %in% c(2005:2015)] <- ifelse(supersom$aktuelltrapport[supersom$year %in% c(2005:2015)] <= 5, 1, 0)
# Public service use: Using Rapport/Aktuellt/Ekot at least 5 days/week (or not).
supersom <- supersom %>%
mutate(psuse = case_when(is.na(aktuelltrapport.dich) & is.na(ekot.dich) ~ 999,
aktuelltrapport.dich == 1 ~ 1, # Aktuellt/Rapport
ekot.dich == 1 ~ 1, # Ekot
TRUE ~ 0))
supersom$psuse <- factor(supersom$psuse, levels=c(1, 0), labels=c("PS news at least 5 days/week", "PS news more seldom"))
# Daily public service use: Using Rapport/Aktuellt/Ekot daily (or not).
supersom <- supersom %>%
mutate(psuse.daily = case_when(jh10b == 1 ~ 1, # Ekot
jh10c == 1 ~ 1, # Aktuellt
jh10d == 1 ~ 1, # Rapport
jh10e == 1 ~ 1, # Aktuellt/Rapport
is.na(jh10b) & is.na(jh10c) & is.na(jh10d) & is.na(jh10e) ~ 999,
TRUE ~ 0))
supersom$psuse.daily <- factor(supersom$psuse.daily, levels=c(1, 0), labels=c("PS news daily", "PS news more seldom"))
supersom$aktuelltrapport.dich <- factor(supersom$aktuelltrapport.dich, levels=c(1, 0), labels=c("Daily/weekly", "Never/seldom"))
# Lef/right block.
supersom$partyblock[supersom$cb10 %in% c(1, 2)] <- 1 # Left: S+V
supersom$partyblock[supersom$cb10 %in% c(3, 4, 5, 6)] <- 2 # Right: C+L+M+KD
supersom$partyblock[supersom$partyblock > 2] <- NA
supersom$partyblock <- factor(supersom$partyblock, levels=1:2, labels=c("Left", "Right"), ordered=FALSE)
supersom$partyblock.num <- as.numeric(supersom$partyblock %>% recode("1"="-1", "2"="-1", "3"="1", "4"="1", "5"="1", "6"="1"))
# Party.
#supersom$party <- factor(supersom$cb10, levels=c(1:7, 10:13, 30), labels=c("Vänsterpartiet", "Socialdemokraterna", "Centerpartiet", "Liberalerna", "Moderaterna", "Kristdemokraterna", "Miljöpartiet", "Sverigedemokraterna", "Feministiskt initiativ", "Piratpartiet", "Ny demokrati", "Övriga"), ordered=FALSE)
supersom$party <- factor(supersom$cb10, levels=c(1:7, 10:13, 30), labels=c("Left Party (V)", "Social Democrats (S)", "Centre Party (C)", "Liberals (L)", "Moderate Party (M)", "Christian Democrats (KD)", "Green Party (MP)", "Sweden Democrats (SD)", "Feminist Initiative (FI)", "Pirate Party (PP)", "New Democracy (NyD)", "Other"), ordered=FALSE)
supersom$partysymbol <- factor(supersom$cb10, levels=c(1:7, 10:13, 30), labels=c("V", "S", "C", "L", "M", "KD", "MP", "SD", "FI", "PP", "NyD", "Other"), ordered=FALSE)
PartyColor <- unlist(list(V = "#DA291C",
S = "#E8112d",
C = "#009933",
L = "#006AB3",
M = "#52BDEC",
KD = "#000077",
MP = "#83CF39",
SD = "#DDDD00",
FI = "#CD1B68",
PP = "#572B85",
NyD = "#572B85",
Other = "#CCCCCC"), use.names=FALSE)
# Ideological extremism (center = 0, toward left/right = 2)
supersom$polextreme <- supersom$ideology %>% recode("1"="2", "2"="1", "3"="0", "4"="1", "5"="2") %>% as.numeric()
# Strong supporter of party?
supersom$partystrength <- supersom$cb20 %>% recode("1"="2", "2"="1", "3"="0")
supersom$partystrength <- factor(supersom$partystrength, levels=c(0,1,2), labels=c("No party supporter", "Weak party supporter", "Strong party supporter"), ordered=FALSE)
# Political leaning: left/center/right.
supersom$leaning <- supersom$ideology %>% recode("1"="1", "2"="1", "3"="2", "4"="3", "5"="3")
supersom$leaning <- factor(supersom$leaning, levels=c(1,2,3), labels=c("Left", "Center", "Right"), ordered=FALSE)
supersom$leaning.num <- as.numeric(supersom$ideology %>% recode("1"="-2", "2"="-1", "3"="0", "4"="1", "5"="2"))
# Like own party & dislike other parties.
supersom$C <- supersom$cb50a
supersom$M <- supersom$cb50b
supersom$V <- supersom$cb50c
supersom$L <- supersom$cb50d
supersom$S <- supersom$cb50e
supersom$MP <- supersom$cb50f
supersom$KD <- supersom$cb50g
#supersom$Nydemok <- supersom$cb50h
supersom$FI <- supersom$cb50i
supersom$SD <- supersom$cb50m
supersom$likeindex <- colSums(rbind(supersom$C, supersom$M, supersom$V, supersom$L, supersom$S, supersom$MP, supersom$KD, supersom$SD, supersom$FI), na.rm = TRUE)
# Factor sex.
supersom$sex <- factor(supersom$sex, levels=c(1, 2), labels=c("Female", "Male"), ordered=FALSE)
# Convert year to date yyyy-mm-dd.
supersom$date <- as.Date(paste(supersom$year, "-01-01", sep=""))
Calculate feelings towards other parties by subtracting feelings toward out-parties from feelings toward the in-party.
Since there are multiple out-parties, add them all together and average them.
# Add all affects.
supersom$affect <- colSums(rbind(supersom$C, supersom$M, supersom$V, supersom$L, supersom$S, supersom$MP, supersom$KD, supersom$SD, supersom$FI), na.rm = TRUE)
# Subtract in-party from total affect (leaving only out-party affect), and then average the out-party affect.
supersom$affect.outparty <- if_else(supersom$partysymbol == "S", (supersom$affect - supersom$S) / 8, supersom$affect)
supersom$affect.outparty <- if_else(supersom$partysymbol == "M", (supersom$affect - supersom$M) / 8, supersom$affect.outparty)
supersom$affect.outparty <- if_else(supersom$partysymbol == "V", (supersom$affect - supersom$V) / 8, supersom$affect.outparty)
supersom$affect.outparty <- if_else(supersom$partysymbol == "MP", (supersom$affect - supersom$MP) / 8, supersom$affect.outparty)
supersom$affect.outparty <- if_else(supersom$partysymbol == "KD", (supersom$affect - supersom$KD) / 8, supersom$affect.outparty)
supersom$affect.outparty <- if_else(supersom$partysymbol == "FI", (supersom$affect - supersom$FI) / 8, supersom$affect.outparty)
supersom$affect.outparty <- if_else(supersom$partysymbol == "C", (supersom$affect - supersom$C) / 8, supersom$affect.outparty)
supersom$affect.outparty <- if_else(supersom$partysymbol == "L", (supersom$affect - supersom$L) / 8, supersom$affect.outparty)
# Make new variable for in-party affect.
supersom$affect.inparty <- if_else(supersom$partysymbol == "S", supersom$S, supersom$affect)
supersom$affect.inparty <- if_else(supersom$partysymbol == "M", supersom$M, supersom$affect.inparty)
supersom$affect.inparty <- if_else(supersom$partysymbol == "V", supersom$V, supersom$affect.inparty)
supersom$affect.inparty <- if_else(supersom$partysymbol == "MP", supersom$MP, supersom$affect.inparty)
supersom$affect.inparty <- if_else(supersom$partysymbol == "KD", supersom$KD, supersom$affect.inparty)
supersom$affect.inparty <- if_else(supersom$partysymbol == "FI", supersom$FI, supersom$affect.inparty)
supersom$affect.inparty <- if_else(supersom$partysymbol == "C", supersom$C, supersom$affect.inparty)
supersom$affect.inparty <- if_else(supersom$partysymbol == "L", supersom$L, supersom$affect.inparty)
Create a additive public service index, with the use of Rapport/Aktuellt/Ekot which is then averaged.
Continous scale ranging from 1 (never) to 6 (daily).
# First, combine Aktuellt & Rapport (1986-2005). Use the highest frequency from either variable. In other words, if respondent use either Aktuellt or Rapport daily, then the value is daily.
# (Cumbersome coding because bug in case_when, see https://github.com/tidyverse/dplyr/issues/2927)
supersom$aktuelltrapport_early[supersom$aktuellt == 6 | supersom$aktuellt == 6] <- 6
supersom$aktuelltrapport_early[supersom$aktuellt == 5 | supersom$aktuellt == 5] <- 5
supersom$aktuelltrapport_early[supersom$aktuellt == 4 | supersom$aktuellt == 4] <- 4
supersom$aktuelltrapport_early[supersom$aktuellt == 3 | supersom$aktuellt == 3] <- 3
supersom$aktuelltrapport_early[supersom$aktuellt == 2 | supersom$aktuellt == 2] <- 2
supersom$aktuelltrapport_early[supersom$aktuellt == 1 | supersom$aktuellt == 1] <- 1
# Add to variable 1986-2004.
supersom$aktuelltrapport.combined[supersom$year <= 2004] <- supersom$aktuelltrapport_early[supersom$year < 2004]
## Warning in supersom$aktuelltrapport.combined[supersom$year <= 2004] <-
## supersom$aktuelltrapport_early[supersom$year < : number of items to replace
## is not a multiple of replacement length
# Use the Aktuellt/Rapport measure from 2005 an onwards.
supersom$aktuelltrapport.combined[supersom$year >= 2005] <- supersom$jh10e[supersom$year >= 2005]
# Add values (Aktuellt and Rapport + Ekot) and divide by 2, thus creating a continous interval scale, from 1-6.
supersom$psindex <- (supersom$aktuelltrapport.combined + supersom$ekot) / 2
# Reverse code index, so that 6=daily, 1=never.
supersom$psindex.rev <- min(supersom$psindex, na.rm=TRUE) + max(supersom$psindex, na.rm=TRUE) - supersom$psindex
# Histogram of index.
ggplot(supersom, aes(psindex.rev)) +
geom_histogram() +
labs(title="Histogram of public service index",
y="Count",
x="Public service index (higher value = more frequent use)")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 15061 rows containing non-finite values (stat_bin).
library(moments)
mean(supersom$psindex.rev, na.rm=TRUE)
## [1] 3.690832
sd(supersom$psindex.rev, na.rm=TRUE)
## [1] 1.38461
skewness(supersom$psindex.rev, na.rm=TRUE)
## [1] 0.03839314
kurtosis(supersom$psindex.rev, na.rm=TRUE)
## [1] 2.124942
supersom %>%
select(date, svt1.dich) %>%
na.exclude() %>%
group_by(date, svt1.dich) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(svt1.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom") +
labs(title="Tittar på SVT", x="Year", y="Percent")
supersom %>%
select(date, svt1.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, svt1.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(svt1.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="SVT1 + leaning",
x="Year",
y="Percent") +
facet_grid(~ leaning)
supersom %>%
select(date, svt1.dich, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, svt1.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(svt1.dich))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="SVT1 & political interest",
x="Year",
y="Percent") +
facet_grid(~ polinterest)
Are public service viewers more extreme in their views?
supersom %>%
select(date, svt1.dich, polextreme) %>%
na.exclude() %>%
group_by(svt1.dich, date) %>%
summarize(meanextremism = mean(polextreme, na.rm=TRUE)) %>%
ggplot(aes(date, meanextremism, color=svt1.dich)) +
geom_line(alpha=0.5) +
geom_smooth(method="loess") +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "none", axis.text.x = element_text(angle=90)) +
labs(title="SVT1 + ideological extremism",
x="Year",
y="Ideological extremism") +
facet_grid(~ svt1.dich)
supersom %>%
select(date, svt2.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, svt2.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(svt2.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="SVT2 + leaning",
x="Year",
y="Percent") +
facet_grid(~ leaning)
supersom %>%
select(date, svt2.dich, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, svt2.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(svt2.dich))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="SVT2 + political interest",
x="Year",
y="Percent") +
facet_grid(~ polinterest)
Swedish Television news programmes Rapport and Aktuellt in SVT1 and SVT2, respectively.
supersom %>%
select(date, rapport.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, rapport.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(rapport.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use SVT Rapport",
x="Year",
y="Percent") +
facet_grid(~ leaning)
supersom %>%
select(date, rapport.dich, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, rapport.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(rapport.dich))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use SVT Rapport",
x="Year",
y="Percent") +
facet_grid(~ polinterest)
supersom %>%
select(date, aktuellt.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, aktuellt.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(aktuellt.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use Aktuellt",
x="Year",
y="Percent") +
facet_grid(~ leaning)
supersom %>%
select(date, aktuellt.dich, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, aktuellt.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(aktuellt.dich))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use Aktuellt",
x="Year",
y="Percent") +
facet_grid(~ polinterest)
supersom %>%
select(date, aktuelltrapport.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, aktuelltrapport.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(aktuelltrapport.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Aktuellt/Rapport",
x="Year",
y="Percent") +
facet_grid(~ leaning)
Combine the two survey questions from 1986-2004 (Aktuellt and Rapport, respectively) with the single survey question from 2005-2014 (Aktuellt/Rapport, combined).
supersom %>%
select(date, aktuelltrapport.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, aktuelltrapport.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(aktuelltrapport.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Aktuell/Rapport",
x="Year",
y="Percent") +
#geom_vline(xintercept = as.numeric(as.Date("2005-01-01")), color="black", alpha=0.9, linetype=2) + # Vertical line that indicate change in survey question
facet_grid(~ leaning)
supersom %>%
select(date, aktuelltrapport.dich, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, aktuelltrapport.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(aktuelltrapport.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Aktuellt/Rapport",
x="Year",
y="Percent") +
geom_vline(xintercept = as.numeric(as.Date("2005-01-01")), color="black", alpha=0.9, linetype=2) +
facet_grid(~ polinterest)
df <- supersom %>% select(polextreme, polinterest.num) %>% na.exclude()
corr.df <- cor.test(df$polextreme, df$polinterest.num)$parameter[[1]]
corr.p <- cor.test(df$polextreme, df$polinterest.num)$p.value
corr.r <- cor(df$polextreme, df$polinterest.num)
Correlation between political extremity and political interest: r(97193) = 0.2548581, p=0.
supersom %>%
select(date, ekot.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, ekot.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(ekot.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Ekot", x="Year", y="Percent") +
facet_grid(~ leaning)
supersom %>%
select(date, ekot.dich, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, ekot.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(ekot.dich))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90, vjust = 0.5)) +
labs(title="Ekot", x="Year", y="Percent") +
facet_grid(~ polinterest)
Use any of Aktuellt, Rapport or Ekot.
Frequency table of public service news use.
supersom %>%
select(year, psuse) %>%
group_by(year, psuse) %>%
na.exclude() %>%
count() %>%
spread(psuse, n)
## # A tibble: 30 x 3
## # Groups: year [30]
## year `PS news at least 5 days/week` `PS news more seldom`
## * <dbl> <int> <int>
## 1 1986 1594 21
## 2 1987 1636 13
## 3 1988 1613 16
## 4 1989 1545 16
## 5 1990 1547 16
## 6 1991 1539 20
## 7 1992 1835 22
## 8 1993 1777 39
## 9 1994 1628 36
## 10 1995 1699 42
## # ... with 20 more rows
supersom %>%
select(date, psuse, leaning) %>%
na.exclude() %>%
group_by(leaning, date, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(psuse))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
#geom_text(aes(label=round(percent), alpha=0.7), nudge_y=-6, size=2) +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="5 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use of public service news programs",
subtitle=NULL,
x="Year",
y="Percent") +
facet_wrap(~ leaning)
print(paste("n =", supersom %>%
select(date, psuse, leaning) %>%
na.exclude() %>% count()))
## [1] "n = 95462"
For the latest year, is the difference statistically significant between the left and right?
left <- supersom %>% filter(year == max(year) & leaning == "Left") %>% select(psuse) %>% na.exclude()
center <- supersom %>% filter(year == max(year) & leaning == "Center") %>% select(psuse) %>% na.exclude()
right <- supersom %>% filter(year == max(year) & leaning == "Right") %>% select(psuse) %>% na.exclude()
t.test(x=as.numeric(center$psuse), y=as.numeric(left$psuse), alternative=c("two.sided"), conf.level=0.95)
##
## Welch Two Sample t-test
##
## data: as.numeric(center$psuse) and as.numeric(left$psuse)
## t = 4.0702, df = 4216.9, p-value = 4.784e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.01665289 0.04760469
## sample estimates:
## mean of x mean of y
## 1.092959 1.060830
t.test(x=as.numeric(center$psuse), y=as.numeric(right$psuse), alternative=c("two.sided"), conf.level=0.95)
##
## Welch Two Sample t-test
##
## data: as.numeric(center$psuse) and as.numeric(right$psuse)
## t = 5.1399, df = 3946.9, p-value = 2.882e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.02374627 0.05303310
## sample estimates:
## mean of x mean of y
## 1.092959 1.054569
t.test(x=as.numeric(left$psuse), y=as.numeric(right$psuse), alternative=c("two.sided"), conf.level=0.95)
##
## Welch Two Sample t-test
##
## data: as.numeric(left$psuse) and as.numeric(right$psuse)
## t = 0.98434, df = 5090.1, p-value = 0.325
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.006208472 0.018730249
## sample estimates:
## mean of x mean of y
## 1.060830 1.054569
supersom %>%
select(date, psuse, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(psuse))) +
geom_line(size=1.2) +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="5 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use of public service news programs",
subtitle=NULL,
x="Year",
y="Percent") +
facet_grid(~ polinterest)
Frequency table of public service news use 1986 and 2015.
print(paste("n =", supersom %>%
select(date, psuse, polinterest) %>%
na.exclude() %>% count()))
## [1] "n = 97257"
supersom %>%
select(year, psuse, polinterest) %>%
na.exclude() %>%
group_by(polinterest, year, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
filter(year %in% c(1986, 2015)) %>%
spread(psuse, n)
## # A tibble: 16 x 5
## # Groups: polinterest, year [8]
## polinterest year percent `PS news at least 5 days/week`
## * <fctr> <dbl> <dbl> <int>
## 1 No political interest 1986 2.6845638 NA
## 2 No political interest 1986 97.3154362 145
## 3 No political interest 2015 30.2663438 NA
## 4 No political interest 2015 69.7336562 288
## 5 Low 1986 0.8498584 NA
## 6 Low 1986 99.1501416 700
## 7 Low 2015 7.9604131 NA
## 8 Low 2015 92.0395869 2139
## 9 Medium 1986 0.6633499 NA
## 10 Medium 1986 99.3366501 599
## 11 Medium 2015 4.2438893 NA
## 12 Medium 2015 95.7561107 3565
## 13 High political interest 1986 3.4965035 NA
## 14 High political interest 1986 96.5034965 138
## 15 High political interest 2015 5.0886662 NA
## 16 High political interest 2015 94.9113338 1231
## # ... with 1 more variables: `PS news more seldom` <int>
supersom %>%
select(date, psuse, polextreme) %>%
na.exclude() %>%
group_by(psuse, date) %>%
summarize(meanextremism = mean(polextreme, na.rm=TRUE)) %>%
ggplot(aes(date, meanextremism, color=psuse)) +
geom_line(alpha=0.5) +
geom_smooth(method="loess") +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "none", axis.text.x = element_text(angle=90)) +
labs(title="Public service use and ideological extremity",
x="Year",
y="Ideological extremism") +
facet_grid(~ psuse)
print(paste("n =", supersom %>%
select(date, psuse, polextreme) %>%
na.exclude() %>% count()))
## [1] "n = 95462"
supersom %>%
select(date, psuse, party) %>%
na.exclude() %>%
group_by(party, date, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
#filter(!party %in% c("Feministiskt initiativ", "Piratpartiet", "Ny demokrati", "Övriga")) %>%
ggplot(aes(date, percent, color=factor(psuse))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="5 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use of public service news programs",
subtitle=NULL,
x="Year",
y="Percent") +
facet_wrap(~ party, ncol = 4)
print(paste("n =", supersom %>%
select(date, psuse, party) %>%
na.exclude() %>%
#filter(!party %in% c("Feministiskt initiativ", "Piratpartiet", "Ny demokrati", "Övriga")) %>%
count()))
## [1] "n = 89929"
# jh10e = Use of Aktuellt/Rapport.
# ka502a = Trust in Swedish Television (SVT).
df <- supersom %>% select(ka502a, jh10e) %>% na.exclude()
corr.df <- cor.test(df$ka502a, df$jh10e)$parameter[[1]]
corr.p <- cor.test(df$ka502a, df$jh10e)$p.value
corr.r <- cor(df$ka502a, df$jh10e)
Correlation between trust in SVT and use of Aktuellt/Rapport: r(9177) = 0.2324653, p=7.003867810^{-113}.
# jh10b = Use of Ekonyheterna
# ka502e = Trust in Swedish Radio (SR).
df <- supersom %>% select(ka502e, jh10b) %>% na.exclude()
corr.df <- cor.test(df$ka502e, df$jh10b)$parameter[[1]]
corr.p <- cor.test(df$ka502e, df$jh10b)$p.value
corr.r <- cor(df$ka502e, df$jh10b)
Correlation between trust in SR and use of Ekonyheterna: r(6934) = 0.3077295, p=4.972765810^{-152}.
supersom %>%
select(date, psuse, partystrength) %>%
na.exclude() %>%
group_by(partystrength, date, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(psuse))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use of public service news programs",
subtitle="Use any of Aktuellt, Rapport or Ekot.",
x="Year",
y="Percent") +
facet_wrap(~ partystrength)
print(paste("n =", supersom %>%
select(date, psuse, partystrength) %>%
na.exclude() %>% count()))
## [1] "n = 91375"
df <- supersom %>%
select(partystrength, psuse) %>%
na.exclude() %>%
mutate(partystrength = as.numeric(partystrength), psuse=as.numeric(psuse))
corr.df <- cor.test(df$partystrength, df$psuse)$parameter[[1]]
corr.p <- cor.test(df$partystrength, df$psuse)$p.value
corr.r <- cor(df$partystrength, df$psuse)
Correlation between public service news use and party identification/support: r(91373) = -0.0367499, p=1.091096210^{-28}.
supersom %>%
select(date, internetnews.dich, leaning) %>%
na.exclude() %>%
group_by(leaning, date, internetnews.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(internetnews.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#005800", "#9cfb9c"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use internet news + leaning",
x="Year",
y="Percent") +
facet_grid(~ leaning)
supersom %>%
select(date, internetnews.dich, party) %>%
na.exclude() %>%
group_by(party, date, internetnews.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(internetnews.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#005800", "#9cfb9c"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use internet news + party",
x="Year",
y="Percent") +
facet_wrap(~ party)
supersom %>%
select(date, internetnews.dich, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, internetnews.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(internetnews.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#005800", "#9cfb9c"), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Use internet news + political interest",
x="Year",
y="Percent") +
facet_grid(~ polinterest)
supersom %>%
select(date, internetnews.dich, psuse) %>%
na.exclude() %>%
group_by(psuse, date, internetnews.dich) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(internetnews.dich))) +
geom_line(size=1.2) +
scale_color_manual(values = c("#005800", "#9cfb9c"), name="Use of internet news") +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="Use of internet news among public service (PS) news users",
x="Year",
y="Percent") +
facet_grid(~ psuse)
supersom %>%
select(date, trust.svt) %>%
na.exclude() %>%
group_by(date, trust.svt) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.svt))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.7), nudge_y=6) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 10)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "right", axis.text.x = element_text(angle=0)) +
labs(title="Trust SVT", x="Year", y="Percent")
supersom %>%
select(date, trust.svt, leaning) %>%
na.exclude() %>%
group_by(leaning, date, trust.svt) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.svt))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.7), nudge_y=6) +
#geom_smooth(method="lm", alpha=0.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Trust SVT", x="Year", y="Percent") +
facet_wrap(~leaning)
supersom %>%
select(date, trust.svt, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, trust.svt) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.svt))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.7), nudge_y=6) +
#geom_smooth(method="lm", alpha=0.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Trust SVT", x="Year", y="Percent") +
facet_grid(~polinterest)
supersom %>%
select(date, trust.svt, party) %>%
na.exclude() %>%
group_by(party, date, trust.svt) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.svt))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.7), nudge_y=10) +
#geom_smooth(method="lm", alpha=0.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Förtroende för SVT",
x="Year",
y="Percent",
caption="Data: Super-SOM 1986-2015") +
facet_wrap(~party)
## Warning: Removed 7 rows containing missing values (geom_text).
supersom %>%
select(date, trust.svt, sns.dich) %>%
na.exclude() %>%
group_by(sns.dich, date, trust.svt) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.svt))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
#geom_smooth(method="lm", alpha=0.5) +
geom_text(aes(label=round(percent), alpha=0.8), nudge_y=8, size=3.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Trust SVT and social networking site use",
x="Year",
y="Percent") +
facet_wrap(~sns.dich)
supersom %>%
select(date, trust.sr) %>%
na.exclude() %>%
group_by(date, trust.sr) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.sr))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.8), nudge_y=8, size=3.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "right", axis.text.x = element_text(angle=0)) +
labs(title="Trust SR", x="Year", y="Percent")
supersom %>%
select(date, trust.sr, leaning) %>%
na.exclude() %>%
group_by(leaning, date, trust.sr) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.sr))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.8), nudge_y=8, size=3.5) +
#geom_smooth(method="lm", alpha=0.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Trust SR", x="Year", y="Percent") +
facet_wrap(~leaning)
supersom %>%
select(date, trust.sr, polinterest) %>%
na.exclude() %>%
group_by(polinterest, date, trust.sr) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.sr))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.8), nudge_y=8, size=3.5) +
#geom_smooth(method="lm", alpha=0.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Trust SR", x="Year", y="Percent") +
facet_grid(~polinterest)
supersom %>%
select(date, trust.sr, party) %>%
na.exclude() %>%
group_by(party, date, trust.sr) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.sr))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.8), nudge_y=8, size=3.5) +
#geom_smooth(method="lm", alpha=0.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Förtroende för SR",
x="Year",
y="Percent",
caption="Data: Super-SOM 1986-2015") +
facet_wrap(~party)
## Warning: Removed 3 rows containing missing values (geom_text).
supersom %>%
select(date, trust.sr, sns.dich) %>%
na.exclude() %>%
group_by(sns.dich, date, trust.sr) %>%
summarize(n = n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(date, percent, color=factor(trust.sr))) +
geom_line(size=1, alpha=1) +
geom_point(size=2) +
geom_text(aes(label=round(percent), alpha=0.8), nudge_y=8, size=3.5) +
#geom_smooth(method="lm", alpha=0.5) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 10)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 0)) +
labs(title="Trust SR, by social networking site use",
x="Year",
y="Percent") +
facet_wrap(~sns.dich)
supersom$age3a <- rio::factorize(supersom$age3a)
supersom %>%
select(date, psuse, age8a) %>%
na.exclude() %>%
group_by(age8a, date, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(psuse))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="Ues of public service news programs and age",
subtitle=NULL,
x="Year",
y="Percent") +
facet_wrap(~ age8a)
print(paste("n =", supersom %>%
select(date, psuse, age8a) %>%
na.exclude() %>% count()))
## [1] "n = 97830"
supersom$sex <- rio::factorize(supersom$sex)
supersom %>%
select(date, psuse, sex) %>%
na.exclude() %>%
filter(as.numeric(sex) < 3) %>%
group_by(sex, date, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(psuse))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="Ues of public service news programs and female/male",
subtitle="Use any of Aktuellt, Rapport or Ekot.",
x="Year",
y="Percent") +
facet_wrap(~ sex)
print(paste("n =", supersom %>%
select(date, psuse, sex) %>%
na.exclude() %>% count()))
## [1] "n = 98565"
supersom$edu3 <- rio::factorize(supersom$edu3)
supersom %>%
select(date, psuse, edu3) %>%
na.exclude() %>%
group_by(edu3, date, psuse) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
ggplot(aes(date, percent, color=factor(psuse))) +
geom_line(size=1.2) +
#geom_smooth(method="lm") +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
scale_y_continuous(labels=scales::comma, limit=c(0, 100), breaks=seq(0, 100, 20)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="Ues of public service news programs and education",
subtitle="Use any of Aktuellt, Rapport or Ekot.",
x="Year",
y="Percent") +
facet_wrap(~ edu3)
print(paste("n =", supersom %>%
select(date, psuse, edu3) %>%
na.exclude() %>% count()))
## [1] "n = 94621"
supersom %>%
select(date, year, partystrength) %>%
group_by(year, partystrength) %>%
na.exclude() %>%
summarize(n=NROW(partystrength)) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(year, percent)) +
geom_line(aes(linetype=partystrength, color=partystrength), size=1.2) +
theme(legend.position = "right") +
labs(title="Party support",
x="Year",
y="Percent")
Political (ideological) leaning on the left-right scale (1-5).
supersom %>%
select(date, year, ideology) %>%
group_by(year, ideology) %>%
summarize(n=NROW(ideology)) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(ideology, percent)) +
geom_area(fill="#666666") +
labs(title="Distribution of political ideology by year",
x="Left/right ideology",
y="Percent") +
facet_wrap(~year)
## Warning: Removed 31 rows containing missing values (position_stack).
supersom %>%
select(date, year, leaning) %>%
group_by(year, leaning) %>%
na.exclude() %>%
summarize(n=NROW(leaning)) %>%
mutate(percent = (n / sum(n)) * 100) %>%
ggplot(aes(year, percent, color=leaning)) +
geom_line(aes(linetype=leaning), size=1.2) +
theme(legend.position = "bottom") +
labs(title="Political leaning by year",
x="Year",
y="Percent")
We should expect an increase in standard deviation over time if people are becoming more polarized along the left-right scale.
supersom %>%
select(ideology, date) %>%
group_by(date) %>%
summarize(meanideology = mean(ideology, na.rm=TRUE), ideology_sd = sd(ideology, na.rm=TRUE)) %>%
ggplot(aes(date, ideology_sd)) +
geom_line() +
#geom_smooth(method="lm") +
geom_smooth(method="lm", formula=y ~ splines::ns(x, df=2)) + # Use cubic with 2 df.
#geom_smooth(method="loess") +
labs(title="Left/right political polarization",
x="Year",
y="Left-right ideology standard deviation")
Ideological consistency, or sorting, where individuals align themselves to parties consistent with their ideology.
supersom %>%
select(year, ideology, partyblock) %>%
#na.exclude() %>%
group_by(year, partyblock, ideology) %>%
summarize(n=n()) %>%
mutate(percent = (n / sum(n)) * 100) %>%
na.exclude() %>%
ggplot() +
geom_area(aes(x=ideology, y=percent, fill=factor(partyblock)), alpha=.8, position="identity") +
scale_color_manual(values=c("#CD614E", "#1B2B5F")) +
scale_fill_manual(values=c("#CD614E", "#1B2B5F")) +
theme(legend.position = "bottom") +
labs(title="Political leaning by party block",
subtitle=NULL,
x="Left/right leaning",
y="Percent",
caption="Left block: V, S. Right block: C, L, KD, M") +
facet_wrap(~ year)
Correlation between leaning and party block identification over time. If polarization is increasing, correlation should increase over time.
df <- supersom %>%
select(leaning.num, partyblock.num, date) %>%
group_by(date, leaning.num, partyblock.num)
df.corr <- plyr::ddply(df, "date", summarise, corr=cor(leaning.num, partyblock.num, method="pearson", use="na.or.complete"))
df.corr %>% mutate(date = format(date, "%Y"))
## date corr
## 1 1986 0.7425293
## 2 1987 0.7257491
## 3 1988 0.7373112
## 4 1989 0.6921111
## 5 1990 0.7101502
## 6 1991 0.7518332
## 7 1992 0.7221279
## 8 1993 0.7050289
## 9 1994 0.7409642
## 10 1995 0.7447632
## 11 1996 0.6914982
## 12 1997 0.7020527
## 13 1998 0.7388663
## 14 1999 0.7312772
## 15 2000 0.7117998
## 16 2001 0.7128053
## 17 2002 0.7598317
## 18 2003 0.6852369
## 19 2004 0.7240041
## 20 2005 0.7062038
## 21 2006 0.7686267
## 22 2007 0.7426668
## 23 2008 0.7388060
## 24 2009 0.7537652
## 25 2010 0.7811740
## 26 2011 0.7575875
## 27 2012 0.7622348
## 28 2013 0.7627043
## 29 2014 0.7937577
## 30 2015 0.7765756
df.corr %>%
ggplot(aes(date, corr)) +
geom_line() +
#geom_point(size=2) +
geom_smooth(method="lm", formula = y ~ splines::ns(x, df=2)) + # Cubic spline w/ 2 df
#geom_text(aes(label=round(corr, 2)), nudge_y=0) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="3 year") +
theme(legend.position = "right", axis.text.x = element_text(angle=0)) +
labs(title="Ideological consistency / sorting",
subtitle=NULL,
x="Year",
y="Pearson correlation")
Compare high and low public service users.
Too few in the never/seldom category to be meaningful. Therefore, those who use PS news daily is contrasted with those who use it more seldom.
supersom %>%
select(leaning.num, psuse.daily, partyblock.num, date) %>%
group_by(date, psuse.daily, leaning.num) %>%
plyr::ddply(c("date", "psuse.daily"), summarise, corr=cor(leaning.num, partyblock.num, method="pearson", use="na.or.complete")) %>%
na.exclude() %>%
ggplot(aes(date, corr)) +
geom_line() +
geom_smooth(method="lm") +
#geom_point(size=2) +
#geom_text(aes(label=round(corr, 2)), nudge_y=0) +
scale_y_continuous(labels=scales::comma, breaks=seq(0, 1, 0.05)) +
scale_x_date(date_label="%Y", date_breaks="3 year") +
theme(legend.position = "right", axis.text.x = element_text(angle=0)) +
labs(title="Ideological consistency (sorting)",
subtitle=NULL,
x="Year",
y="Pearson Correlation") +
facet_grid(~ psuse.daily)
Compare high and low internet users.
supersom %>%
select(leaning.num, internetnews.dich, partyblock.num, date) %>%
group_by(date, internetnews.dich, leaning.num, partyblock.num) %>%
plyr::ddply(c("date", "internetnews.dich"), summarise, corr=cor(leaning.num, partyblock.num, method="pearson", use="na.or.complete")) %>%
na.exclude() %>%
ggplot(aes(date, corr)) +
geom_line() +
geom_smooth(method="lm") +
#geom_point(size=2) +
#geom_text(aes(label=round(corr, 2)), nudge_y=0) +
scale_y_continuous(labels=scales::comma, breaks=seq(0, 1, 0.02)) +
scale_x_date(date_label="%Y", date_breaks="3 year") +
theme(legend.position = "right", axis.text.x = element_text(angle=0)) +
labs(title="Ideological consistency (sorting)",
subtitle=NULL,
x="Year",
y="Pearson Correlation") +
facet_grid(~ internetnews.dich)
# Get block party + ideology for all years.
df <- supersom %>%
select(date, year, ideology, partyblock) %>%
filter(partyblock == "Left" | partyblock == "Right") %>% # Only include left + right parties, exclude small parties.
group_by(year, partyblock) %>%
summarize(n=NROW(ideology)) %>%
mutate(percent = (n / sum(n)) * 100)
# Sort after year, decreasing.
df <- within(df, year <- ordered(year, levels=rev(sort(unique(year)))))
# Fix order of the geom_bar.
df$position[df$partyblock == "Left"] <- 2
## Warning: Unknown or uninitialised column: 'position'.
df$position[df$partyblock == "Right"] <- 1
# Stacked bar plot.
ggplot(df, aes(x=factor(year), y=percent, fill=partyblock, group=position)) + # group=position stacks the geom_bar.
geom_bar(stat="identity") +
scale_color_manual(values=c("red", "blue")) +
scale_fill_manual(values=c("red", "blue")) +
#scale_y_continuous(trans="reverse") +
theme(legend.position="bottom", legend.title = element_blank()) +
geom_hline(yintercept=50, color="white", alpha=0.5) +
geom_text(data=df[df$partyblock=="Left", ], y=5, aes(label=formatC(round(percent, 1), format='f', digits=1)), color="white", alpha=.5, position="identity") + # Add percent to bar
geom_text(data=df[df$partyblock=="Right", ], y=95, aes(label=formatC(round(percent, 1), format='f', digits=1)), color="white", alpha=.4, position="identity") + # Add percent to bar
labs(title="Support for party block over time",
x="Year",
y="Percent") +
coord_flip()
# Note: Keep trailing zeros (i.e., 43.0): formatC(round(percent, 1), format='f', digits=1)
# Order by increasing year in facet_wrap.
df$year <- factor(df$year, levels = sort(unique(df$year), decreasing = TRUE))
# Facet by year.
ggplot(df, aes(x=partyblock, y=percent, color=partyblock, fill=partyblock)) +
geom_bar(stat="identity") +
scale_color_manual(values=c("red", "blue")) +
scale_fill_manual(values=c("red", "blue")) +
theme_bw() +
labs(title="Support for party block over time",
x="Left/right ideology",
y="Percent") +
facet_wrap(~year, strip.position = "top")
Like and dislike of political parties.
library(reshape2)
##
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
##
## smiths
supersom %>%
select(C, M, V, L, S, MP, KD, SD, FI, year) %>%
melt(id="year", measure.vars=c("C", "M", "V", "L", "S", "MP", "KD", "SD", "FI")) %>%
filter(value < 10) %>%
ggplot(aes(x=variable, y=value, fill=variable)) +
geom_boxplot() +
theme(legend.position = "none") +
labs(title="Like and dislike of party by year",
x="Party identification",
y="Like/dislike") +
coord_flip() +
facet_wrap(~ year)
## Warning: attributes are not identical across measure variables; they will
## be dropped
supersom %>%
select(date, likeindex) %>%
na.exclude() %>%
dplyr::group_by(date) %>%
dplyr::summarize(meanlike = mean(likeindex, na.rm=TRUE)) %>%
ggplot(aes(date, meanlike)) +
geom_line() +
geom_point(size=2) +
#geom_smooth(method="lm", alpha=0.3) +
#scale_color_manual(values = c("#000000", "#CCCCCC"), name="Social networking site use") +
#scale_y_continuous(labels=scales::comma, limits=c(-10, 10)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Like/dislike",
x="Year",
y="Mean value -45 to +45")
supersom %>%
select(date, leaning, likeindex) %>%
na.exclude() %>%
dplyr::group_by(date, leaning) %>%
dplyr::summarize(meanlike = mean(likeindex, na.rm=TRUE)) %>%
ggplot(aes(date, meanlike)) +
geom_line() +
geom_point(size=2) +
#geom_smooth(method="lm", alpha=0.3) +
#scale_color_manual(values = c("#000000", "#CCCCCC"), name="Social networking site use") +
#scale_y_continuous(labels=scales::comma, limits=c(-10, 10)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Like/dislike",
x="Year",
y="Mean value -45 to +45") +
facet_grid(~ leaning)
supersom %>%
select(C, M, V, L, S, MP, KD, SD, FI, year, party) %>%
melt(id="party", measure.vars=c("C", "M", "V", "L", "S", "MP", "KD", "SD", "FI")) %>%
filter(value < 10) %>%
na.exclude() %>%
ggplot(aes(x=variable, y=value, fill=variable)) +
geom_boxplot() +
labs(title="Like and dislike of parties by party", x="Party", y="Like/dislike") +
theme(legend.position = "none") +
coord_flip() +
facet_wrap(~ party)
## Warning: attributes are not identical across measure variables; they will
## be dropped
supersom %>%
select(C, M, V, L, S, MP, KD, SD, FI, party, date) %>%
melt(id=c("party", "date"), measure.vars=c("C", "M", "V", "L", "S", "MP", "KD", "SD", "FI")) %>%
filter(value < 10) %>%
na.exclude() %>%
group_by(party, date) %>%
summarize(meanvalue = mean(value, na.rm=TRUE)) %>%
ggplot(aes(date, meanvalue, color=party)) +
geom_line(size=1) +
#geom_point(size=1.2) +
#geom_smooth(method="lm", alpha=0.3) +
#scale_color_manual(values = c("#000000", "#CCCCCC"), name="Social networking site use") +
scale_color_manual(values = unlist(PartyColor, use.names = FALSE)) +
#scale_y_continuous(labels=scales::comma, limits=c(0, 10)) +
#scale_x_date(date_label="%Y", date_breaks="1 year") +
geom_hline(yintercept = 0, alpha=0.4, linetype=2) +
theme(legend.position = "none", axis.text.x = element_text(angle=0)) +
labs(title="Like/dislike of political parties, by each party",
x="Year",
y="Mean value -5 to +5") +
facet_wrap(~ party)
## Warning: attributes are not identical across measure variables; they will
## be dropped
# Affect out-party.
supersom %>%
select(date, party, partysymbol, affect.outparty) %>%
filter(partysymbol %in% c("S", "V", "MP", "L", "C", "KD", "M", "SD")) %>%
na.exclude() %>%
group_by(date, party) %>%
summarize(val = mean(affect.outparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="red") +
geom_hline(yintercept = 0, alpha=0.4, linetype=2) +
geom_smooth(method="lm") +
#scale_y_continuous(labels=scales::comma, limit=c(-5, 5)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Out-party affect",
subtitle=NULL,
x="Year",
y="Out-party affect (mean)") +
facet_wrap(~ party, ncol=4)
# Affect in-party.
supersom %>%
select(date, party, partysymbol, affect.inparty) %>%
filter(partysymbol %in% c("S", "V", "MP", "L", "C", "KD", "M", "SD")) %>%
na.exclude() %>%
group_by(date, party) %>%
summarize(val = mean(affect.inparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="green") +
geom_smooth(method="lm") +
geom_hline(yintercept = 0, alpha=0.4, linetype=2) +
#scale_y_continuous(labels=scales::comma, limit=c(-11, 11)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="In-party affect",
subtitle=NULL,
x="Year",
y="In-party affect (mean)") +
facet_wrap(~ party, ncol=4)
# Affect out-party + internet.
supersom %>%
select(date, internet.dich, affect.outparty) %>%
na.exclude() %>%
group_by(date, internet.dich) %>%
summarize(val = mean(affect.outparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="red") +
geom_hline(yintercept = 0, alpha=0.4, linetype=2) +
scale_y_continuous(labels=scales::comma, limit=c(-2, 2)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="Out-party affect + internet",
subtitle=NULL,
x="Year",
y="Out-party affect (mean)") +
facet_wrap(~ internet.dich, ncol=4)
# Affect out-party + social networking sites.
supersom %>%
select(date, sns.dich, affect.outparty) %>%
na.exclude() %>%
group_by(date, sns.dich) %>%
summarize(val = mean(affect.outparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="red") +
geom_hline(yintercept = 0, alpha=0.4, linetype=2) +
scale_y_continuous(labels=scales::comma, limit=c(-2, 2)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="Out-party affect + SNS",
subtitle=NULL,
x="Year",
y="Out-party affect (mean)") +
facet_wrap(~ sns.dich, ncol=4)
# Affect in-party + social networking sites.
supersom %>%
select(date, sns.dich, affect.inparty) %>%
na.exclude() %>%
group_by(date, sns.dich) %>%
summarize(val = mean(affect.inparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="darkgreen", alpha=0.2) +
geom_smooth(method="lm", alpha=0.2, color="black") +
#scale_y_continuous(labels=scales::comma, limit=c(-2, 2)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="In-party affect + SNS",
subtitle=NULL,
x="Year",
y="In-party affect (mean)") +
facet_wrap(~ sns.dich, ncol=4)
# Affect in-party + PS.
gg1 <- supersom %>%
select(date, psuse.daily, affect.inparty) %>%
na.exclude() %>%
group_by(date, psuse.daily) %>%
summarize(val = mean(affect.inparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="red", alpha=0.2) +
geom_smooth(method="lm", alpha=0.2, color="black") +
#geom_hline(yintercept = 0, alpha=0.4) +
#scale_y_continuous(labels=scales::comma, limit=c(-2, 2)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="In-party affect",
subtitle=NULL,
x="Year",
y="Affect (mean)") +
facet_wrap(~ psuse.daily, ncol=4)
# Affect out-party + PS
gg2 <- supersom %>%
select(date, psuse.daily, affect.outparty) %>%
na.exclude() %>%
group_by(date, psuse.daily) %>%
summarize(val = mean(affect.outparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="blue", alpha=0.2) +
geom_smooth(method="lm", alpha=0.2, color="black") +
#geom_hline(yintercept = 0, alpha=0.4, linetype=2) +
#scale_y_continuous(labels=scales::comma, limit=c(-2, 2)) +
scale_x_date(date_label="%Y", date_breaks="4 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="Out-party affect",
subtitle=NULL,
x="Year",
y="Affect (mean)") +
facet_wrap(~ psuse.daily, ncol=4)
library(gridExtra)
##
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
##
## combine
grid.arrange(gg1, gg2)
# Affect in-party + political interest
gg1 <- supersom %>%
select(date, polinterest, affect.inparty) %>%
na.exclude() %>%
group_by(date, polinterest) %>%
summarize(val = mean(affect.inparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="red", alpha=0.2) +
geom_smooth(method="lm", alpha=0.2, color="black") +
#geom_hline(yintercept = 0, alpha=0.4) +
#scale_y_continuous(labels=scales::comma, limit=c(-2, 2)) +
scale_x_date(date_label="%Y", date_breaks="8 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="In-party affect",
subtitle=NULL,
x="Year",
y="Affect (mean)") +
facet_grid(~ polinterest)
# Affect out-party + political interest
gg2 <- supersom %>%
select(date, polinterest, affect.outparty) %>%
na.exclude() %>%
group_by(date, polinterest) %>%
summarize(val = mean(affect.outparty)) %>%
ggplot(aes(date, val)) +
geom_line(size=1.2, color="blue", alpha=0.2) +
geom_smooth(method="lm", alpha=0.2, color="black") +
#geom_hline(yintercept = 0, alpha=0.4, linetype=2) +
#scale_y_continuous(labels=scales::comma, limit=c(-2, 2)) +
scale_x_date(date_label="%Y", date_breaks="8 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Out-party affect",
subtitle=NULL,
x="Year",
y="Affect (mean)") +
facet_grid(~ polinterest)
library(gridExtra)
grid.arrange(gg1, gg2)
Beliefs, views and attitudes on various issues.
High and low internet use.
supersom %>%
select(date, marry, internet.dich) %>%
na.exclude() %>%
group_by(internet.dich, date, marry) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
filter(marry == "Agree") %>%
ggplot(aes(date, percent)) +
geom_line(size=1.2, color="#005800") +
#geom_point(size=1.2) +
scale_y_continuous(labels=scales::comma, breaks=seq(0, 100, 5)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
#scale_color_manual(values = "#005800", name=NULL) +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="\"I would not like an immigrant marrying a family member\"",
subtitle=NULL,
x="Year",
y="Percent agreement") +
facet_grid(~ internet.dich)
High and low public service news use.
supersom %>%
select(date, marry, psuse) %>%
na.exclude() %>%
group_by(psuse, date, marry) %>%
summarize(n = n()) %>%
mutate(percent = n / sum(n) * 100) %>%
filter(marry == "Agree") %>%
ggplot(aes(date, percent)) +
geom_line(size=1.2, color="#106FAF") +
#geom_point(size=1.2) +
scale_y_continuous(labels=scales::comma, breaks=seq(0, 100, 5)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
scale_color_manual(values = sort(brewer.pal(3, "Paired")), name=NULL) +
theme(legend.position = "bottom", axis.text.x = element_text(angle=0)) +
labs(title="\"I would not like an immigrant marrying a family member\"",
subtitle=NULL,
x="Year",
y="Percent agreement") +
facet_grid(~ psuse)
supersom %>%
select(date, leaning, fc10e) %>%
na.exclude() %>%
filter(fc10e < 10) %>%
group_by(date, leaning) %>%
summarize(meanvalue = mean(fc10e, na.rm=TRUE)) %>%
ggplot(aes(date, meanvalue)) +
geom_line(size=1) +
geom_point(size=3) +
#geom_smooth(method="lm", alpha=0.3) +
scale_color_manual(values = c("#000000", "#CCCCCC")) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="I would not like immigrant marriying family member",
x="Year",
y="Mean value") +
facet_grid(~ leaning)
supersom %>%
select(date, leaning, fc10b) %>%
na.exclude() %>%
filter(fc10b < 10) %>%
group_by(date, leaning) %>%
summarize(meanvalue = mean(fc10b, na.rm=TRUE)) %>%
ggplot(aes(date, meanvalue)) +
geom_line(size=1) +
geom_point(size=3) +
#geom_smooth(method="lm", alpha=0.3) +
scale_color_manual(values = c("#000000", "#CCCCCC")) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Immigrants should be able to practice their religion freely",
x="Year",
y="Mean value") +
facet_grid(~ leaning)
supersom %>%
select(date, leaning, bb100k) %>%
na.exclude() %>%
filter(bb100k < 50) %>%
group_by(date, leaning) %>%
summarize(meaninternet = mean(bb100k, na.rm=TRUE)) %>%
ggplot(aes(date, meaninternet)) +
geom_line(size=1) +
geom_point(size=3) +
#geom_smooth(method="lm", alpha=0.3) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name="Social networking site use") +
scale_y_continuous(labels=scales::comma, limits=c(0, 10)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Internet is essential to stay informed about news",
x="Year",
y="Mean value (1-10)") +
facet_grid(~ leaning)
supersom %>%
select(date, leaning, bb100h) %>%
na.exclude() %>%
filter(bb100h < 50) %>%
group_by(date, leaning) %>%
summarize(meanvalue = mean(bb100h, na.rm=TRUE)) %>%
ggplot(aes(date, meanvalue)) +
geom_line(size=1) +
geom_point(size=3) +
#geom_smooth(method="lm", alpha=0.3) +
scale_color_manual(values = c("#000000", "#CCCCCC"), name="Social networking site use") +
scale_y_continuous(labels=scales::comma, limits=c(0, 10)) +
scale_x_date(date_label="%Y", date_breaks="1 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Internet can only complement news papers, radio and television",
x="Year",
y="Mean value (1-10)") +
facet_grid(~ leaning)
Demography, summary statistics, number of respondents etc.
supersom %>%
group_by(date) %>%
select(date, polinterest.num) %>%
summarize(meaninterest=mean(polinterest.num, na.rm=TRUE)) %>%
ggplot(aes(date, meaninterest)) +
geom_line(alpha=0.4) +
geom_smooth(method = "loess", level=0.95, color="blue", alpha=0.3) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
geom_vline(xintercept = as.numeric(as.Date("2004-01-01")), color="black", alpha=0.9, linetype=2) +
#geom_vline(xintercept = as.numeric(as.Date("2006-01-01")), color="black", alpha=0.9, linetype=4)
annotate("text", x=as.Date("2008-06-01"), y=2.35, label="Facebook launches 2004") +
labs(title="Mean political interest",
subtitle="Loess smoothing with 95 % CI.",
x="Year",
y="Political interest (1–4)")
supersom %>%
group_by(leaning, date) %>%
select(date, polinterest.num) %>%
na.exclude() %>%
summarize(meaninterest=mean(polinterest.num, na.rm=TRUE)) %>%
ggplot(aes(date, meaninterest)) +
geom_line(alpha=0.4) +
#geom_smooth(method = "loess", level=0.95, color="blue", alpha=0.3) +
#geom_smooth(method = "lm", level=0.95, color="blue", alpha=0.3) +
geom_smooth(method = "lm", formula=y ~ splines::ns(x, df=2), level=0.95, color="blue", alpha=0.3) +
scale_y_continuous(labels=scales::comma, limits = c(2, 3)) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(axis.text.x = element_text(angle=90)) +
labs(title="Political interest (mean)",
subtitle=NULL,
x="Year",
y="Political interest (1–4)") +
#geom_vline(xintercept = as.numeric(as.Date("2004-01-01")), color="black", alpha=0.9, linetype=2) +
#geom_vline(xintercept = as.numeric(as.Date("2006-01-01")), color="black", alpha=0.9, linetype=4)
#annotate("text", x=as.Date("2008-06-01"), y=2.35, label="Facebook launches 2004") +
facet_wrap(~ leaning)
## Adding missing grouping variables: `leaning`
supersom %>%
group_by(date) %>%
select(date, ideology) %>%
summarize(meanideology=mean(ideology, na.rm=TRUE)) %>%
ggplot(aes(date, meanideology)) +
geom_line() +
#geom_smooth(method = "lm", level=0.95) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
geom_hline(yintercept=3, linetype=2) +
labs(title="Ideology per year (mean)", x="Year", y="Ideology (1=left, 5=right)")
Ideological extremism by year.
supersom %>%
group_by(date) %>%
select(date, polextreme) %>%
summarize(meanextremism=mean(polextreme, na.rm=TRUE)) %>%
ggplot(aes(date, meanextremism)) +
geom_line(alpha=0.4) +
geom_smooth(method = "loess", level=0.95, color="blue", alpha=0.3) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
labs(title="Ideological extremism (mean)",
subtitle=NULL,
x="Year",
y="Ideological extremism (0-2)") +
geom_vline(xintercept = as.numeric(as.Date("2004-01-01")), color="black", alpha=0.9, linetype=2) +
#geom_vline(xintercept = as.numeric(as.Date("2006-01-01")), color="black", alpha=0.9, linetype=4)
annotate("text", x=as.Date("2008-06-01"), y=1.23, label="Facebook launches 2004")
Ideological extremism by party block.
supersom %>%
group_by(leaning, date) %>%
select(date, polextreme, leaning) %>%
na.exclude() %>%
summarize(meanextremism=mean(polextreme, na.rm=TRUE)) %>%
filter(meanextremism > 0) %>%
ggplot(aes(date, meanextremism, color=leaning)) +
geom_line(alpha=0.8) +
geom_smooth(method = "loess", level=0.95, alpha=0.15) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(date_label="%Y", date_breaks="2 year") +
theme(legend.position = "bottom", axis.text.x = element_text(angle=90)) +
labs(title="Ideological extremism (mean)",
subtitle=NULL,
x="Year",
y="Ideological extremism (0–2)") +
facet_grid(~leaning)
supersom %>%
ggplot(aes(year)) +
geom_bar(position="stack", aes(fill=factor(formular))) +
theme(legend.position = "none") +
labs(title="Respondents per year and survey",
subtitle="Colors indicate the different surveys.",
x="Year",
y="Respondents")
Sample:
print(paste("Total n =", nrow(supersom)))
## [1] "Total n = 103589"
print(paste("Age mean =", mean(supersom$age, na.rm=TRUE)))
## [1] "Age mean = 48.5126053726528"
print(paste("Age SD =", sd(supersom$age, na.rm=TRUE)))
## [1] "Age SD = 18.1446076498253"
Data from page 542 table 5: http://som.gu.se/digitalAssets/1487/1487725_531-560-frida-vernersdotter--metod.pdf
surveys <- data.frame(
year=1986:2015,
date=as.Date(seq.Date(as.Date("1986-01-01"), as.Date("2015-01-01"), by = "year")),
responserate=c(65,67,66,63,63,63,67,66,61,63,63,63,64,63,59,61,60,61,60,58,55,57,54,55,56,52,52,49,51,51)
)
print(paste("Response rate M =", mean(surveys$responserate)))
## [1] "Response rate M = 59.6"
print(paste("Response rate SD =", sd(surveys$responserate)))
## [1] "Response rate SD = 5.24963052887107"
surveys %>% ggplot(aes(date, responserate)) +
geom_line() +
scale_y_continuous(limits = c(0, 100)) +
labs(title="Response rate", x="Year", y="Percent")
(Not included)
# Append significance stars depending on p-value.
sigstars <- function(p) {
p <- as.numeric(p)
if(p < 0.001) { return ("***") }
if(p < 0.01) { return ("**") }
if(p < 0.05) { return ("*") }
return("")
}
# Coefficient plot for LM.
coefplot <- function(model, intercept=FALSE, sort=FALSE, title="Predictors", caption="*p<0.05 **p<0.01 ***p<0.001. Bars represent 95 % C.I.", labels=NULL, nudge_y=0.3, nudge_x=0) {
library(broom)
if(!is.null(labels)) {
names(model$coefficients) <- labels # Rename labels.
}
df <- tidy(model, conf.int=TRUE)
if(intercept == FALSE){
df <- df %>% filter(term != "(Intercept)")
}
df <- df %>% mutate(label = paste(round(estimate, 2), sapply(p.value, FUN=sigstars), sep=""))
if(sort == TRUE) {
df$term <- reorder(df$term, df$estimate) # Sort by estimate, descdending order.
}
ggplot(df, aes(estimate, term)) +
geom_point(size=3, fill="black") +
geom_errorbarh(aes(xmin=conf.low, xmax=conf.high), width=0.2, height=0, lwd=1, lty=1, col="black") +
geom_vline(xintercept = 0, color="black", alpha=0.5, linetype=2) +
geom_text(aes(label=label, alpha=1), nudge_y=nudge_y, nudge_x=nudge_x) +
theme(legend.position = "none") +
labs(title=title,
caption=caption,
x="Regression coefficient (unstandardized)",
y=NULL)
}
# Coefficient plot for MLM.
coefplot_mlm <- function(model, intercept=FALSE, sort=FALSE, title="Predictors", caption="Bars represent 95 % C.I.", labels=NULL, nudge_y=0.3, nudge_x=0) {
library(broom)
if(!is.null(labels)) {
names(model$coefficients) <- labels # Rename labels.
}
df <- tidy(model, conf.int=TRUE)
if(intercept == FALSE){
df <- df %>% filter(term != "(Intercept)")
}
df <- df %>% mutate(label = paste(round(estimate, 2), sep=""))
if(sort == TRUE) {
df$term <- reorder(df$term, df$estimate) # Sort by estimate, descdending order.
}
df %>%
na.exclude() %>%
ggplot(aes(estimate, term)) +
geom_point(size=3, fill="black") +
geom_errorbarh(aes(xmin=conf.low, xmax=conf.high), width=0.2, height=0, lwd=1, lty=1, col="black") +
geom_vline(xintercept = 0, color="black", alpha=0.5, linetype=2) +
geom_text(aes(label=label, alpha=1), nudge_y=nudge_y, nudge_x=nudge_x) +
theme(legend.position = "none") +
labs(title=title,
caption=caption,
x="Estimate",
y=NULL)
}
# Return confidence interval for the PLM's.
# From http://rforpublichealth.blogspot.se/2014/10/easy-clustered-standard-errors-in-r.html
plm_confint <- function(model, vcovCL){
t <- qt(0.975, model$df.residual)
ct <- coeftest(model, vcovCL)
est <- cbind(ct[,1], ct[,1] - t * ct[,2], ct[,1] + t * ct[,2])
colnames(est) <- c("Estimate","LowerCI","UpperCI")
return(est)
}
Prepare data for models.
# Set reference categories.
supersom$polinterest <- relevel(supersom$polinterest, ref="No political interest")
supersom$party <- relevel(supersom$party, ref="Social Democrats (S)")
supersom$leaning <- relevel(supersom$leaning, ref="Center")
# Center year 1986 as 0.
supersom$year_centered <- supersom$year - 1986
Simple model with only the main predictors.
# Linear model.
m1 <- lm(psindex.rev ~ leaning + polinterest.num + year_centered, data=supersom)
summary(m1)
##
## Call:
## lm(formula = psindex.rev ~ leaning + polinterest.num + year_centered,
## data = supersom)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5515 -0.9243 0.0441 1.0441 3.2740
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.3115165 0.0181655 127.248 < 2e-16 ***
## leaningLeft 0.0036642 0.0114493 0.320 0.749
## leaningRight 0.0730934 0.0112547 6.494 8.38e-11 ***
## polinterest.num 0.5564094 0.0057784 96.291 < 2e-16 ***
## year_centered -0.0048949 0.0005463 -8.960 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.305 on 85212 degrees of freedom
## (18372 observations deleted due to missingness)
## Multiple R-squared: 0.1054, Adjusted R-squared: 0.1054
## F-statistic: 2511 on 4 and 85212 DF, p-value: < 2.2e-16
coefplot(m1, title=NULL, labels=c("(Intercept)", "Leaning left", "Leaning right", "Political interest", "Time (0-30)"))
## Warning: Ignoring unknown parameters: width
More predictors. Clustered standard errors.
m2 <- lm(psindex.rev ~ factor(polinterest) + sex + factor(age4a) + edu3 + leaning + year_centered + I(year_centered * as.integer(polinterest)), data=supersom)
library(stargazer)
##
## Please cite as:
## Hlavac, Marek (2015). stargazer: Well-Formatted Regression and Summary Statistics Tables.
## R package version 5.2. http://CRAN.R-project.org/package=stargazer
stargazer(m2, type="text")
##
## ==========================================================================================
## Dependent variable:
## -----------------------------
## psindex.rev
## ------------------------------------------------------------------------------------------
## factor(polinterest)Low 0.355***
## (0.021)
##
## factor(polinterest)Medium 0.626***
## (0.030)
##
## factor(polinterest)High political interest 0.749***
## (0.043)
##
## sexMale 0.146***
## (0.008)
##
## factor(age4a)2 0.632***
## (0.012)
##
## factor(age4a)3 1.205***
## (0.013)
##
## factor(age4a)4 1.751***
## (0.014)
##
## edu3Medel (allt över grundskola men ej högskola/universitet) 0.090***
## (0.012)
##
## edu3Hög (studier/examen från högskola/universitet) 0.158***
## (0.013)
##
## leaningLeft 0.054***
## (0.011)
##
## leaningRight 0.070***
## (0.010)
##
## year_centered -0.037***
## (0.002)
##
## I(year_centered * as.integer(polinterest)) 0.008***
## (0.001)
##
## Constant 2.426***
## (0.029)
##
## ------------------------------------------------------------------------------------------
## Observations 81,484
## R2 0.277
## Adjusted R2 0.277
## Residual Std. Error 1.173 (df = 81470)
## F Statistic 2,396.730*** (df = 13; 81470)
## ==========================================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
print(paste("n =", nrow(model.frame(m2))))
## [1] "n = 81484"
coefplot(m2, sort=TRUE, intercept=TRUE, title=NULL, caption=NULL,
labels=c("(Intercept)", "Low political interest", "Medium political interest", "High political interest", "Male", "30–49 years", "50–64 years", "65 years or older", "Medium education", "High education", "Leaning left", "Leaning right", "Time (0–30)", "Time × Political interest"),
nudge_y=0, nudge_x=0.2)
## Warning: Ignoring unknown parameters: width
Add party.
m3 <- lm(psindex.rev ~ factor(polinterest) + sex + factor(age4a) + edu3 + leaning + as.numeric(partystrength) + year_centered + I(year_centered * as.integer(polinterest)) + factor(party), data=supersom)
stargazer(m3, type="text")
##
## ==========================================================================================
## Dependent variable:
## -----------------------------
## psindex.rev
## ------------------------------------------------------------------------------------------
## factor(polinterest)Low 0.349***
## (0.023)
##
## factor(polinterest)Medium 0.616***
## (0.032)
##
## factor(polinterest)High political interest 0.749***
## (0.046)
##
## sexMale 0.158***
## (0.009)
##
## factor(age4a)2 0.611***
## (0.012)
##
## factor(age4a)3 1.179***
## (0.013)
##
## factor(age4a)4 1.713***
## (0.015)
##
## edu3Medel (allt över grundskola men ej högskola/universitet) 0.093***
## (0.012)
##
## edu3Hög (studier/examen från högskola/universitet) 0.159***
## (0.014)
##
## leaningLeft 0.063***
## (0.013)
##
## leaningRight 0.046***
## (0.013)
##
## as.numeric(partystrength) -0.001
## (0.006)
##
## year_centered -0.034***
## (0.002)
##
## I(year_centered * as.integer(polinterest)) 0.008***
## (0.001)
##
## factor(party)Left Party (V) -0.044**
## (0.017)
##
## factor(party)Centre Party (C) 0.167***
## (0.021)
##
## factor(party)Liberals (L) 0.087***
## (0.019)
##
## factor(party)Moderate Party (M) -0.015
## (0.017)
##
## factor(party)Christian Democrats (KD) 0.051**
## (0.022)
##
## factor(party)Green Party (MP) -0.088***
## (0.017)
##
## factor(party)Sweden Democrats (SD) -0.206***
## (0.025)
##
## factor(party)Feminist Initiative (FI) -0.144**
## (0.057)
##
## factor(party)Pirate Party (PP) -0.594***
## (0.071)
##
## factor(party)New Democracy (NyD) -0.008
## (0.067)
##
## factor(party)Other -0.163***
## (0.034)
##
## Constant 2.420***
## (0.034)
##
## ------------------------------------------------------------------------------------------
## Observations 74,626
## R2 0.275
## Adjusted R2 0.275
## Residual Std. Error 1.167 (df = 74600)
## F Statistic 1,134.419*** (df = 25; 74600)
## ==========================================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
print(paste("n =", nrow(model.frame(m3))))
## [1] "n = 74626"
coefplot(m3, sort=TRUE, intercept=TRUE, title=NULL, caption=NULL,
labels=c("(Intercept)", "Low political interest", "Medium political interest", "High political interest", "Male", "30–49 years", "50–64 years", "65 years or older", "Medium education", "High education", "Leaning left", "Leaning right", "Party ID strength (1–3)", "Time (0–30)", "Time × Political interest", "Left Party (V)", "Centre Party(C)", "Liberals (L)", "Moderate Party (M)", "Christian Democrats (KD)", "Green Party (MP)", "Sweden Democrats (SD)", "Feminist Initiative (FI)", "Pirate Party (PP)", "New Democracy (NyD)", "Other party"),
nudge_y=0, nudge_x=0.3)
## Warning: Ignoring unknown parameters: width
Add internet news use + social networking site use + SVT trust + SR trust.
m4 <- lm(psindex.rev ~ factor(polinterest) + sex + factor(age4a) + internetnews + sns + edu3 + leaning + as.numeric(partystrength) + factor(party) + factor(trust.svt) + (trust.sr) + year_centered + I(year_centered * as.integer(polinterest)), data=supersom)
stargazer(m4, type="text")
##
## ========================================================================================
## Dependent variable:
## ---------------------------
## psindex.rev
## ----------------------------------------------------------------------------------------
## factor(polinterest)Low 0.112
## (0.332)
##
## factor(polinterest)Medium 0.522
## (0.647)
##
## factor(polinterest)High political interest 0.741
## (0.970)
##
## sexMale 0.081**
## (0.034)
##
## factor(age4a)2 0.751***
## (0.050)
##
## factor(age4a)3 1.419***
## (0.054)
##
## factor(age4a)4 1.947***
## (0.063)
##
## internetnews 0.020**
## (0.009)
##
## sns -0.041***
## (0.007)
##
## edu3Medel (allt över grundskola men ej högskola/universitet) 0.039
## (0.056)
##
## edu3Hög (studier/examen från högskola/universitet) 0.028
## (0.060)
##
## leaningLeft -0.131**
## (0.052)
##
## leaningRight 0.019
## (0.049)
##
## as.numeric(partystrength) 0.015
## (0.024)
##
## factor(party)Left Party (V) 0.008
## (0.072)
##
## factor(party)Centre Party (C) 0.019
## (0.084)
##
## factor(party)Liberals (L) -0.027
## (0.079)
##
## factor(party)Moderate Party (M) -0.131**
## (0.062)
##
## factor(party)Christian Democrats (KD) -0.140
## (0.098)
##
## factor(party)Green Party (MP) -0.080
## (0.059)
##
## factor(party)Sweden Democrats (SD) -0.113
## (0.078)
##
## factor(party)Feminist Initiative (FI) -0.134
## (0.166)
##
## factor(party)Pirate Party (PP) -0.502**
## (0.216)
##
## factor(party)Other -0.248
## (0.180)
##
## factor(trust.svt)Neither low nor high -0.103
## (0.063)
##
## factor(trust.svt)Low trust -0.050
## (0.128)
##
## trust.srNeither low nor high -0.428***
## (0.062)
##
## trust.srLow trust -0.651***
## (0.126)
##
## year_centered -0.032
## (0.036)
##
## I(year_centered * as.integer(polinterest)) 0.002
## (0.012)
##
## Constant 3.171***
## (0.632)
##
## ----------------------------------------------------------------------------------------
## Observations 4,876
## R2 0.363
## Adjusted R2 0.359
## Residual Std. Error 1.105 (df = 4845)
## F Statistic 91.944*** (df = 30; 4845)
## ========================================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
coefplot(m4, sort=TRUE, title="Predictor of public service news use", nudge_y=0, nudge_x=0.5)
## Warning: Ignoring unknown parameters: width
library(plm)
## Loading required package: Formula
##
## Attaching package: 'plm'
## The following objects are masked from 'package:dplyr':
##
## between, lag, lead
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(multiwayvcov)
p.df <- supersom %>% select(year, psindex.rev, polinterest.num, year, year_centered) %>% pdata.frame(index=c("year"))
plm1 <- plm(psindex.rev ~ polinterest.num + year_centered, data = p.df)
# OLS coefficients and standard errors clustered by year, from http://www.richard-bluhm.com/clustered-ses-in-r-and-stata-2/
# Compute Stata like df-adjustment.
G <- length(unique(p.df$year))
N <- length(p.df$year)
dfa <- (G / (G - 1)) * (N - 1) / plm1$df.residual
# display with cluster VCE and df-adjustment.
time_c_vcov <- dfa * vcovHC(m3, type = "HC0", cluster = "time", adjust = T)
plm2 <- coeftest(plm1, vcov = time_c_vcov)
coefplot(plm1, title="Predictors of public service use, normal SE's")
## Warning: Ignoring unknown parameters: width
#coefplot(plm2, title="Predictors of public service use, clustered SE's")
Empty model, only dependent variable and year as a random intercept.
library(lme4)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following object is masked from 'package:tidyr':
##
## expand
##
## Attaching package: 'lme4'
## The following object is masked _by_ '.GlobalEnv':
##
## dummy
## The following object is masked from 'package:rio':
##
## factorize
mlm1 <- lmer(psindex.rev ~ 1 + (1 | year), data=supersom, REML=FALSE)
summary(mlm1)
## Linear mixed model fit by maximum likelihood ['lmerMod']
## Formula: psindex.rev ~ 1 + (1 | year)
## Data: supersom
##
## AIC BIC logLik deviance df.resid
## 308755.9 308784.1 -154375.0 308749.9 88525
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.0249 -0.8419 -0.1162 0.6406 1.7927
##
## Random effects:
## Groups Name Variance Std.Dev.
## year (Intercept) 0.003972 0.06303
## Residual 1.913791 1.38340
## Number of obs: 88528, groups: year, 30
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) 3.69399 0.01262 292.7
Year as random intercept + political interest as fixed slope.
library(lme4)
mlm2 <- lmer(psindex.rev ~ 1 + polinterest + (1 | year), data=supersom, REML=FALSE)
summary(mlm2)
## Linear mixed model fit by maximum likelihood ['lmerMod']
## Formula: psindex.rev ~ 1 + polinterest + (1 | year)
## Data: supersom
##
## AIC BIC logLik deviance df.resid
## 294007.5 294063.8 -146997.8 293995.5 87302
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.69499 -0.72829 -0.00125 0.76691 2.72783
##
## Random effects:
## Groups Name Variance Std.Dev.
## year (Intercept) 0.006472 0.08045
## Residual 1.696626 1.30255
## Number of obs: 87308, groups: year, 30
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) 2.61148 0.02160 120.92
## polinterestLow 0.77277 0.01730 44.68
## polinterestMedium 1.37644 0.01707 80.64
## polinterestHigh political interest 1.73461 0.02018 85.97
##
## Correlation of Fixed Effects:
## (Intr) plntrL plntrM
## polintrstLw -0.659
## polntrstMdm -0.667 0.833
## plntrstHgpi -0.563 0.705 0.717
Year as random intercept + everything else as fixed slope.
mlm3 <- lmer(psindex.rev ~ 1 + factor(polinterest) + sex + factor(age4a) + edu3 + leaning + as.numeric(partystrength) + I(year_centered * as.numeric(polinterest)) + (1 | year_centered), data=supersom, REML=FALSE)
summary(mlm3)
## Linear mixed model fit by maximum likelihood ['lmerMod']
## Formula: psindex.rev ~ 1 + factor(polinterest) + sex + factor(age4a) +
## edu3 + leaning + as.numeric(partystrength) + I(year_centered *
## as.numeric(polinterest)) + (1 | year_centered)
## Data: supersom
##
## AIC BIC logLik deviance df.resid
## 243776.5 243924.6 -121872.3 243744.5 77297
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.5534 -0.7189 -0.0678 0.7583 3.6496
##
## Random effects:
## Groups Name Variance Std.Dev.
## year_centered (Intercept) 0.08187 0.2861
## Residual 1.36748 1.1694
## Number of obs: 77313, groups: year_centered, 29
##
## Fixed effects:
## Estimate
## (Intercept) 1.8692775
## factor(polinterest)Low 0.3793572
## factor(polinterest)Medium 0.6618708
## factor(polinterest)High political interest 0.7975130
## sexMale 0.1461993
## factor(age4a)2 0.6247171
## factor(age4a)3 1.1963702
## factor(age4a)4 1.7432904
## edu3Medel (allt över grundskola men ej högskola/universitet) 0.0923657
## edu3Hög (studier/examen från högskola/universitet) 0.1637141
## leaningLeft 0.0535141
## leaningRight 0.0685691
## as.numeric(partystrength) -0.0023585
## I(year_centered * as.numeric(polinterest)) 0.0072388
## Std. Error
## (Intercept) 0.0580260
## factor(polinterest)Low 0.0218768
## factor(polinterest)Medium 0.0309370
## factor(polinterest)High political interest 0.0440827
## sexMale 0.0085950
## factor(age4a)2 0.0121292
## factor(age4a)3 0.0131602
## factor(age4a)4 0.0146536
## edu3Medel (allt över grundskola men ej högskola/universitet) 0.0120914
## edu3Hög (studier/examen från högskola/universitet) 0.0133623
## leaningLeft 0.0111063
## leaningRight 0.0109778
## as.numeric(partystrength) 0.0062511
## I(year_centered * as.numeric(polinterest)) 0.0006621
## t value
## (Intercept) 32.21
## factor(polinterest)Low 17.34
## factor(polinterest)Medium 21.39
## factor(polinterest)High political interest 18.09
## sexMale 17.01
## factor(age4a)2 51.51
## factor(age4a)3 90.91
## factor(age4a)4 118.97
## edu3Medel (allt över grundskola men ej högskola/universitet) 7.64
## edu3Hög (studier/examen från högskola/universitet) 12.25
## leaningLeft 4.82
## leaningRight 6.25
## as.numeric(partystrength) -0.38
## I(year_centered * as.numeric(polinterest)) 10.93
##
## Correlation matrix not shown by default, as p = 14 > 12.
## Use print(x, correlation=TRUE) or
## vcov(x) if you need it
coefplot_mlm(mlm3, title="Fixed effects", caption="Year as random effect", sort=TRUE, nudge_y=0, nudge_x=0.2)
## Warning: Ignoring unknown parameters: width
Correlation matrix.
print(mlm3, correlation=TRUE)
## Linear mixed model fit by maximum likelihood ['lmerMod']
## Formula: psindex.rev ~ 1 + factor(polinterest) + sex + factor(age4a) +
## edu3 + leaning + as.numeric(partystrength) + I(year_centered *
## as.numeric(polinterest)) + (1 | year_centered)
## Data: supersom
## AIC BIC logLik deviance df.resid
## 243776.5 243924.6 -121872.3 243744.5 77297
## Random effects:
## Groups Name Std.Dev.
## year_centered (Intercept) 0.2861
## Residual 1.1694
## Number of obs: 77313, groups: year_centered, 29
## Fixed Effects:
## (Intercept)
## 1.869277
## factor(polinterest)Low
## 0.379357
## factor(polinterest)Medium
## 0.661871
## factor(polinterest)High political interest
## 0.797513
## sexMale
## 0.146199
## factor(age4a)2
## 0.624717
## factor(age4a)3
## 1.196370
## factor(age4a)4
## 1.743290
## edu3Medel (allt över grundskola men ej högskola/universitet)
## 0.092366
## edu3Hög (studier/examen från högskola/universitet)
## 0.163714
## leaningLeft
## 0.053514
## leaningRight
## 0.068569
## as.numeric(partystrength)
## -0.002359
## I(year_centered * as.numeric(polinterest))
## 0.007239
Show locale and package versions for reproducibility.
sessionInfo()
## R version 3.4.1 (2017-06-30)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 15063)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Swedish_Sweden.1252 LC_CTYPE=Swedish_Sweden.1252
## [3] LC_MONETARY=Swedish_Sweden.1252 LC_NUMERIC=C
## [5] LC_TIME=Swedish_Sweden.1252
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] lme4_1.1-13 Matrix_1.2-10 multiwayvcov_1.2.3
## [4] lmtest_0.9-35 zoo_1.8-0 plm_1.6-5
## [7] Formula_1.2-2 stargazer_5.2 broom_0.4.2
## [10] gridExtra_2.2.1 reshape2_1.4.2 lubridate_1.6.0
## [13] moments_0.14 bindrcpp_0.2 purrr_0.2.2.2
## [16] readr_1.1.1 tidyr_0.6.3 tibble_1.3.3
## [19] tidyverse_1.1.1 RColorBrewer_1.1-2 ggplot2_2.2.1
## [22] rio_0.5.5 dplyr_0.7.1
##
## loaded via a namespace (and not attached):
## [1] httr_1.2.1 jsonlite_1.5 splines_3.4.1
## [4] modelr_0.1.0 assertthat_0.2.0 cellranger_1.1.0
## [7] yaml_2.1.14 backports_1.1.0 lattice_0.20-35
## [10] quantreg_5.33 glue_1.1.1 digest_0.6.12
## [13] rvest_0.3.2 minqa_1.2.4 colorspace_1.3-2
## [16] sandwich_2.3-4 htmltools_0.3.6 plyr_1.8.4
## [19] psych_1.7.5 pkgconfig_2.0.1 SparseM_1.77
## [22] haven_1.1.0 scales_0.4.1 openxlsx_4.0.17
## [25] MatrixModels_0.4-1 mgcv_1.8-17 car_2.1-5
## [28] nnet_7.3-12 lazyeval_0.2.0 pbkrtest_0.4-7
## [31] mnormt_1.5-5 magrittr_1.5 readxl_1.0.0
## [34] evaluate_0.10.1 nlme_3.1-131 MASS_7.3-47
## [37] forcats_0.2.0 xml2_1.1.1 foreign_0.8-69
## [40] tools_3.4.1 data.table_1.10.4 hms_0.3
## [43] stringr_1.2.0 munsell_0.4.3 compiler_3.4.1
## [46] rlang_0.1.1 grid_3.4.1 nloptr_1.0.4
## [49] labeling_0.3 rmarkdown_1.6 boot_1.3-19
## [52] gtable_0.2.0 curl_2.7 R6_2.2.2
## [55] knitr_1.16 bdsmatrix_1.3-2 bindr_0.1
## [58] rprojroot_1.2 stringi_1.1.5 parallel_3.4.1
## [61] Rcpp_0.12.11
0.6 Social networking sites (SNS)
0.6.1 SNS & Extremity
Are social media users more extreme in their views?
0.6.2 SNS t-test
0.6.3 SNS & leaning
Note that the survey question changed in 2014.
0.6.4 SNS & party support
Note that the survey question changed in 2014.
0.6.5 SNS & political interest
Note that the survey question changed in 2014.
0.6.6 SNS & PS use
0.6.7 SNS + internet news
0.6.8 Twitter med
#aktuellttrendTwitter trends collected every hour since 2014.
Same thing again, but relative to all trends that week.